PPPR
PPPR Team
library(vroom)
library(sf)
library(ggplot2)
library(ggmap)
library(kableExtra)
library(tidyverse)
library(data.table)
#remotes::install_github("CityOfPhiladelphia/rphl")
library(rphl)
library(lubridate)
library(furrr)
library(tidycensus)
library(rgdal)
library(furrr)
library(mapview)
ll <- function(dat, proj4 = 4326){st_transform(dat, proj4)}
root.dir = "https://raw.githubusercontent.com/urbanSpatial/Public-Policy-Analytics-Landing/master/DATA/"
source("https://raw.githubusercontent.com/urbanSpatial/Public-Policy-Analytics-Landing/master/functions.r")
#windowsFonts(font = windowsFont('Helvetica'))
crs = 'EPSG:2272'
plotTheme <- function(base_size = 9, title_size = 10){
theme(
text = element_text( color = "black"),
plot.title = element_text(size = title_size, colour = "black", hjust = 0.5),
plot.subtitle = element_text( face = 'italic',
size = base_size, colour = "black", hjust = 0.5),
plot.caption = element_text( hjust=0),
axis.ticks = element_blank(),
panel.background = element_blank(),
panel.grid.major = element_line("grey80", size = 0.01),
panel.grid.minor = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=.5),
strip.background = element_blank(),
strip.text = element_text( size=9),
axis.title = element_text( size=9),
axis.text = element_text( size=7),
axis.text.y = element_text( size=7),
plot.background = element_blank(),
legend.background = element_blank(),
legend.title = element_text( colour = "black", face = "italic", size = 9),
legend.text = element_text( colour = "black", face = "italic", size = 7),
strip.text.x = element_text( size = 9),
legend.key.size = unit(.5, 'line')
)
}
mapTheme <- function(base_size = 9, title_size = 10){
theme(
text = element_text( color = "black"),
plot.title = element_text(size = title_size, colour = "black", hjust = 0.5),
plot.subtitle = element_text( face = 'italic',
size = base_size, colour = "black", hjust = 0.5),
plot.caption = element_text( hjust=0),
axis.ticks = element_blank(),
panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
strip.background = element_blank(),
strip.text = element_text(size=base_size),
axis.title = element_text( size=9),
axis.text = element_blank(),
axis.text.y = element_blank(),
plot.background = element_blank(),
legend.background = element_blank(),
legend.title = element_text( colour = "black", face = "italic", size = 9),
legend.text = element_text( colour = "black", face = "italic", size = 7),
strip.text.x = element_text(size=base_size),
legend.key.size = unit(.5, 'line')
)
}
palette5 <- c("#f9b294","#f2727f","#c06c86","#6d5c7e","#315d7f")
palette4 <- c("#f9b294","#f2727f","#c06c86","#6d5c7e")
palette2 <- c("#f9b294","#f2727f")
palette1_main <- "#F2727F"
palette1_assist <- '#F9B294'## NOTE: You will need to create secrets.json, using the template
## to enter private credentials for interacting with the database
get_secrets <- function() {
path <- "secrets/secrets.json"
if (!file.exists(path)) {
stop("Can't find secret file: '", path, "'")
}
jsonlite::read_json(path)
}
#secrets <- get_secrets()
# database settings
# dbname = secrets$db_name
# host = secrets$db_host
# port = secrets$db_port
# username = secrets$db_username
# password = secrets$db_password
# census_api_key(secrets$census_api_key, install=TRUE, overwrite=TRUE)Data Loading
Folder: SafeGraph
These two datasets (‘brand_info’ and ‘core_poi’ from safegraph) are dictionary data.
#HPS = home_panel_summary
#NS = normalization_stats
#VPS = visit_panel_summary
monthList = c("01","02","03","04","05","06","07","08","09","10","11")
# home_panel_summary
hpsAllMonth = data.frame()
for (i in monthList){
currentMonth = vroom(paste("data/safegraph/SafeGraph Data Purchase Dec-16-2021/Philadelphia-Camden-WilmingtonPA-NJ-DE-MDMSA-PATTERNS-2021_",
i,
"-2021-12-17/home_panel_summary.csv",sep = ""))%>%
filter(region=="pa")
hpsAllMonth = rbind(hpsAllMonth,currentMonth)
#print(paste("Current input home_panel_summary dataframe is in ",i," month",sep = ""))
}
# kable(head(hpsAllMonth,3),align = 'c',caption = '<center>Table 3. home pannel summary of 2021 whole year in SafeGraph data <center/>')%>%
# kable_classic(full_width = F)%>%
# kable_styling(position = "center")%>%
# scroll_box(width = "100%", height = "400px")
# normalization_Stats
nsAllMonth = data.frame()
for (i in monthList){
currentMonth = vroom(paste("data/safegraph/SafeGraph Data Purchase Dec-16-2021/Philadelphia-Camden-WilmingtonPA-NJ-DE-MDMSA-PATTERNS-2021_",
i,
"-2021-12-17/normalization_stats.csv",sep = ""))%>%
filter(region=="pa")
nsAllMonth = rbind(nsAllMonth,currentMonth)
#print(paste("Current input normalization_stats dataframe is in ",i," month",sep = ""))
}
# kable(head(nsAllMonth,3),align = 'c',caption = '<center>Table 4. normalization stats of 2021 whole year in SafeGraph data <center/>')%>%
# kable_classic(full_width = F)%>%
# kable_styling(position = "center")%>%
# scroll_box(width = "100%", height = "400px")
# visit_panel_summary
vpsAllMonth = data.frame()
for (i in monthList){
currentMonth = vroom(paste("data/safegraph/SafeGraph Data Purchase Dec-16-2021/Philadelphia-Camden-WilmingtonPA-NJ-DE-MDMSA-PATTERNS-2021_",
i,
"-2021-12-17/visit_panel_summary.csv",sep = ""))%>%
filter(region=="pa")
vpsAllMonth = rbind(vpsAllMonth,currentMonth)
#print(paste("Current input visit_panel_summary dataframe is in ",i," month",sep = ""))
}
# kable(head(vpsAllMonth,3),align = 'c',caption = '<center>Table 5. visit panel summary of 2021 whole year in SafeGraph data <center/>')%>%
# kable_classic(full_width = F)%>%
# kable_styling(position = "center")%>%
# scroll_box(width = "100%", height = "400px")
# Pattern
patternAllMonth = data.frame()
for (i in monthList){
currentMonth = vroom(paste("data/safegraph/SafeGraph Data Purchase Dec-16-2021/Philadelphia-Camden-WilmingtonPA-NJ-DE-MDMSA-PATTERNS-2021_",
i,
"-2021-12-17/patterns.csv.gz",sep = ""))%>%
filter(region=="PA")%>%
mutate(month=paste(i,sep = ""))
patternAllMonth = rbind(patternAllMonth,currentMonth)
#print(paste("Current input patterns dataframe is in ",i," month",sep = ""))
}
# kable(head(patternAllMonth,3),align = 'c',caption = '<center>Table 6. patterns of 2021 whole year in SafeGraph data <center/>')%>%
# kable_classic(full_width = F)%>%
# kable_styling(position = "center")%>%
# scroll_box(width = "100%", height = "400px")This is the whole safegraph raw data, it has four datasets. One is the aggregated pattern data for 2021 whole year. That is the primary one for this project. And the other two datasets give information about the number of active devices.
Folder: OpenDataPhilly
Relevant data of PPR finder
philly <- st_read("https://opendata.arcgis.com/datasets/405ec3da942d4e20869d4e1449a2be48_0.geojson")
pprDistrict <- st_read('https://opendata.arcgis.com/datasets/0cdc4a1e86c6463b9600f9d9fca39875_0.geojson') %>%
st_transform(crs)
destDistrict <- pprDistrict %>% filter(DISTRICTID %in% c(7,8,9))
base_map <- get_map(location = unname(st_bbox(ll(st_buffer(st_union(pprDistrict),11000)))),maptype = "terrian")
ggmap(base_map) +
geom_sf(data=ll(st_union(pprDistrict)),color="black",size=2,fill = "transparent",inherit.aes = FALSE)+
geom_sf(data=ll(pprDistrict),color='black',size=2,fill = "transparent",inherit.aes = FALSE)+
geom_sf(data=ll(destDistrict),color=palette1_main,size=2,fill = "transparent",inherit.aes = FALSE)+
labs(title = "",
subtitle = "",
x="",y="")+
mapTheme()
Figure 1. Locations of pprDistrict
The whole Philadelphia is divided into 10 PPR districts, and the project mainly focus on the District 7、8、9 as pilot project which are highlighted in the map using the color red. Note: The 9 district does not include the Smith Area.
pprProperties <- st_read('https://opendata.arcgis.com/datasets/d52445160ab14380a673e5849203eb64_0.geojson')%>%
st_transform(crs)
ggplot() +
geom_sf(data=pprProperties,color=palette1_main,fill = palette1_main)+
geom_sf(data=st_union(pprDistrict),color="black",size=2,fill = "transparent")+
geom_sf(data=pprDistrict,color="black",size=1,linetype ="dashed",fill = "transparent")+
labs(title = "",
subtitle = "",
x="",y="")+
mapTheme()
Figure 2. Locations of pprProperties
And there are other datasets from the PPR finder unused right now. They are datasets about the types, number and quality of facilities of PPR.
Folder: FromPPR
These are datasets directly from PPR officers. These datasets are highly related to our project.
pprServiceArea <- read_sf(dsn="data/FromPPR/PPR_Service_Areas_2021/PPR_Service_Areas_2021.shp")%>%
st_transform(crs = crs)
pprDestServiceArea <- pprServiceArea %>% filter(PPR_DIST %in% c(7,8,9))
ggplot() +
geom_sf(data=pprServiceArea,color='black',size=1,fill = "transparent")+
geom_sf(data=pprDestServiceArea,color=palette1_main,size=2,fill = "transparent")+
geom_sf(data=st_union(pprDistrict),color="black",size=2,fill = "transparent")+
labs(title = "",
subtitle = "",
x="",y="")+
mapTheme()
Figure 15. Locations of pprServiceArea
The above map is about service areas. Each district unit is divided into several service area units for the sake of administration. The pink lines in the map are the services areas in District 7,8,9. These service areas are the target of this project.
program2021 <- vroom("data/FromPPR/PPR-programs-attended-2021-with-schedules.csv")
kable(head(program2021,3),align = 'c',caption = '<center>Table 8. Program information of PPR Programs data <center/>')%>%
kable_classic(full_width = F)%>%
kable_styling(position = "center")%>%
scroll_box(width = "100%", height = "460px")| FacilityID | Facility | ProgramID | ActvityTypeCategory | ActivityType | Gender | AgeLow | AgeHigh | AttendanceWeekDate | RegisteredIndividualsCount | UniqueIndividualCount | ProgramScheduleID | DateFrom | DateTo | Days | TimeFrom | TimeTo |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| {C8420FF3-289F-4737-A4F5-FF44DE89CA58} | McVeigh Recreation Center | 300 | After School | After School | M/F | 6 | 12 | 12/27/2021 | 21 | 0 | 8348 | 9/13/2021 | 5/27/2022 | Monday Tuesday Wednesday Thursday Friday | 15:00:00 | 18:00:00 |
| {DA9F8E3A-D19A-46DD-9040-5ACE360CDD2A} | Kendrick Recreation Center | 4800 | Athletic | Gymnastics / Tumbling | M/F | 3 | 5 | 12/13/2021 | 12 | 12 | 8883 | 12/6/2021 | 2/26/2022 | Thursday | 17:30:00 | 18:30:00 |
| {DA9F8E3A-D19A-46DD-9040-5ACE360CDD2A} | Kendrick Recreation Center | 4800 | Athletic | Gymnastics / Tumbling | M/F | 3 | 5 | 12/13/2021 | 12 | 12 | 8504 | 9/16/2021 | 11/18/2021 | Thursday | 17:30:00 | 18:30:00 |
The above dataset gives information about PPR programs in 2021, including information like the duration of the program, the attendence of the program etc. But some wrangling are needed for further uses. And the wrangling is taken in the next section.
facilityID <- read.csv("data/FromPPR/tblFacility_to_PPR_Properties.csv")The above dataset is offered as dictionary data to provide links between facility id and PPR property object id. ({003695FA-5CC6-4572-9916-799609577319} - 209). Right now the dataset only contains 7,8,9 districts. The others will be offered at the end of the Feburary.
Data Wrangling
Property data
# # replace "and" with "&"
# pprProperties <- pprProperties %>%
# mutate(OFFICIAL_NAME = gsub("and", "&", pprProperties$OFFICIAL_NAME),
# PUBLIC_NAME = gsub("and", "&", pprProperties$PUBLIC_NAME))
#
#
# # join method 1
# property.join1 <- left_join(propertyArea,
# pprProperties %>% dplyr::select(ADDRESS_911, geometry),
# by=c("X911.Address"="ADDRESS_911"), left=FALSE) %>%
# filter(!st_is_empty(geometry))
#
# # join method 2
# property.join2 <- left_join(propertyArea,
# pprProperties %>% dplyr::select(OFFICIAL_NAME, geometry),
# by=c("PPR.Site.Name"="OFFICIAL_NAME"), left=FALSE) %>%
# filter(!st_is_empty(geometry))
#
# # join method 3
# property.join3 <- left_join(propertyArea,
# pprProperties %>% dplyr::select(PUBLIC_NAME, geometry),
# by=c("PPR.Site.Name"="PUBLIC_NAME"), left=FALSE) %>%
# filter(!st_is_empty(geometry))
#
# # combine 3 methods together
# property <- rbind(property.join1,property.join2) %>%
# rbind(property.join3,.) %>%
# distinct() %>%
# st_sf()
#
# x <- left_join(propertyArea, property, by="PPR.Site.Name") %>%
# filter(st_is_empty(geometry))
# According to the email, we should directly use pprProperties to spatial join the service area to get the service area information. Therefore, the above code should be delete.
property <- st_join(st_centroid(pprProperties),pprServiceArea,left=TRUE) %>%
st_drop_geometry() %>%
left_join(pprProperties %>% dplyr::select(OBJECTID,geometry),by='OBJECTID') %>%
st_sf() %>%
st_transform(crs = 4326) %>%
dplyr::select(-Shape__Length,-Shape__Area,-Shape_Leng,-Shape_Area) %>%
rename('ServiceAreaID' = 'INFO')# map the location of properties in district 7,8,9
ggplot() +
geom_sf(data=property %>% filter(PPR_DIST %in% c(7,8,9)),color=palette1_main,fill = palette1_main)+
geom_sf(data=st_union(pprDestServiceArea %>% filter(PPR_DIST ==7)),color="black",size=2,fill = "transparent")+
geom_sf(data=st_union(pprDestServiceArea %>% filter(PPR_DIST ==8)),color="black",size=2,fill = "transparent")+
geom_sf(data=st_union(pprDestServiceArea %>% filter(PPR_DIST ==9)),color="black",size=2,fill = "transparent")+
geom_sf(data=pprDestServiceArea,color="black",size=0.75,linetype ="dashed",fill = "transparent")+
labs(title = "",
subtitle = "",
x="",y="")+
mapTheme()
Figure. Locations of properties in District 7,8,9
Through above wrangling, we obtain the newest data about property and link them with service areas. The map only map the properties in the district 7/8/9
Program data
# define date
program2021.clean <- program2021 %>%
mutate(AttendanceWeekDate = mdy(AttendanceWeekDate),
DateFrom = mdy(DateFrom),
DateTo = mdy(DateTo))
# create a df only containing records without program scheduel info
program2021.NA <- program2021.clean[is.na(program2021.clean$ProgramScheduleID),]
# filter by attendance date
program2021.clean <- program2021.clean %>%
filter(AttendanceWeekDate > DateFrom & AttendanceWeekDate < DateTo)
# original data is recorded by week, here we change it into being recorded by occurence
program2021.clean <- separate(program2021.clean, Days,into= c("1","2","3","4","5","6","7"))
program2021.clean <- program2021.clean %>%
gather(colNames, weekday, 15:21) %>%
select(-colNames) %>%
na.omit(cols='weekday')
# create exact attendance date
program2021.clean <- program2021.clean %>%
mutate(AttendenceRealDate = case_when(
weekday == "Monday" ~ AttendanceWeekDate,
weekday == "Tuesday" ~ AttendanceWeekDate+1,
weekday == "Wednesday" ~ AttendanceWeekDate+2,
weekday == "Thursday" ~ AttendanceWeekDate+3,
weekday == "Friday" ~ AttendanceWeekDate+4,
weekday == "Saturday" ~ AttendanceWeekDate+5,
weekday == "Sunday" ~ AttendanceWeekDate+6,
))Through above wrangling, we obtain the real attendance date for each event. (p.s. a program may have more than one events which links with different program schedualed ids)
program2021.join <- left_join(program2021.clean, facilityID, by =c("FacilityID" = "FacilityID")) %>%
left_join(., property, by =c("PPR_Properties_ObjectID"="OBJECTID"))
# get the failed joining items
program2021.join.na <- program2021.join[is.na(program2021.join$PPR_Properties_ObjectID),]
# filter the failed joining items
program2021.join <- program2021.join %>% drop_na(PPR_Properties_ObjectID)Through above wrangling, we link program data to their based properties,their belonged Service Area.
SafeGraph Data
# filter into philly
safeGraph <- patternAllMonth %>%
filter(city == "Philadelphia")
# join with POI and brand data
safeGraph <- safeGraph %>%
left_join(core_poi %>% dplyr::select(placekey,location_name,top_category,sub_category,naics_code,latitude,longitude),
by=c("placekey"="placekey","location_name" = "location_name"),keep=FALSE)
# safeGraph <- safeGraph %>%
# left_join(core_poi, by=c("placekey","parent_placekey","location_name","street_address","city","region","postal_code","safegraph_brand_ids","brands"),keep=FALSE) %>%
# left_join(brand_info, by=c("safegraph_brand_ids"="safegraph_brand_id","brands"="brand_name","top_category","sub_category","naics_code"),keep=FALSE)
# create geometry from lat & lng
safeGraph.geo <-
safeGraph %>%
st_as_sf(coords = c("longitude", "latitude"), crs = 4326, agr = "constant", na.fail=FALSE)# change workers number by yourself
plan(multiprocess, workers = 10)
# keep congeneric bussiness
congenericMoves <-
safeGraph.geo %>%
filter(top_category %in% c("Promoters of Performing Arts, Sports, and Similar Events",
"Other Amusement and Recreation Industries",
"Museums, Historical Sites, and Similar Institutions") | str_detect(location_name, "Park") | str_detect(location_name, "Playground") | str_detect(location_name, "Recreation Center")) %>%
filter(str_detect(location_name, "Parking", negate = TRUE))
# Keep only ppr sites
#712190:Nature Parks and Other Similar Institutions;
#713990:All Other Amusement and Recreation Industries;
#713940: Fitness and Recreational Sports Centers；
#711310：Promoters of Performing Arts, Sports, and Similar Events
parks <- safeGraph.geo %>%
dplyr::select(placekey, naics_code, location_name) %>%
distinct() %>%
filter(naics_code %in% c(712190, 713990, 713940, 711310) | str_detect(location_name, "Park") | str_detect(location_name, "Playground") | str_detect(location_name, "Recreation Center")) %>%
filter(str_detect(location_name, "Parking", negate = TRUE)) %>%
st_transform(crs = 4326)
PPRmoves <- safeGraph.geo %>%
filter(placekey %in% as.list(parks$placekey))
# join filtered safeGraph place with ppr property
propertyWithPlaceKey <- st_join(property %>% st_buffer(10),parks %>% dplyr::select(placekey, geometry),left=FALSE) %>%
st_drop_geometry() %>%
left_join(property %>% dplyr::select(OBJECTID),by=('OBJECTID'='OBJECTID')) %>%
st_sf() %>%
st_transform(crs=4326) %>%
drop_na(placekey)
# count
print(paste0("The number of PPR properties is ", n_distinct(property$PUBLIC_NAME),"The number joined properties is ", n_distinct(propertyWithPlaceKey$PUBLIC_NAME)))In the above map, the polygon is the properties of PPR, the green dots are the successfully join properties with placekey
program2021.joinWithPlaceKey <-
st_join(program2021.join %>%
st_sf() %>%
st_transform(crs=4326) %>%
st_buffer(10),
parks %>% dplyr::select(placekey, geometry),left=FALSE) %>%
st_drop_geometry() %>%
merge.data.frame(program2021.join %>%
dplyr::select(geometry),
by='row.names')%>%
dplyr::select(-Row.names) %>%
st_sf() %>%
st_transform(crs=4326)
mapview(property)+mapview(program2021.joinWithPlaceKey,col.regions = "red")EXPLORATORY – CENSUS DATA
1. Get each of the Philadelphia PPR zones
ggplot() +
geom_sf(data=ll(st_union(pprDistrict)),color="black",size=2,fill = "transparent",inherit.aes = FALSE)+
geom_sf(data=ll(pprDistrict),color=palette1_main,size=2,fill = "transparent",inherit.aes = FALSE)+
labs(title = "",
subtitle = "",
x="",y="")+
mapTheme()
2. Get the list of PHL census tracts that intersect with each zone
# ggplot(PPRmoves)+
# geom_line(aes(x = date_range_start, y = raw_visit_counts))+
# facet_wrap(~location_name, scales = "free")Loading Data into Database
EXPLORATORY – SafeGrpah DATA
sumVisit <- visitCount %>%
dplyr::select(-visitDay,-day,-month) %>%
group_by(placekey) %>%
summarise(visits=sum(visits))
ggplot(sumVisit)+
geom_sf(data=pprServiceArea,
color='black',
size=0.25,
fill= "transparent")+
geom_sf(data=pprServiceArea %>% filter(PPR_DIST %in% c(7,8,9)),
color='black',
size=0.5,
fill= "transparent")+
geom_sf(aes(size = visits),
color = palette1_main,
fill = palette1_main,
alpha = 0.3) +
scale_size_continuous(range = c(1, 3),
name = "Visits")+
mapTheme()+
theme(legend.position = "bottom",
legend.key.width = unit(1.5, 'cm'),
legend.key.height = unit(1.2, 'cm'))
Figure. Map of total visits
The above is the aggragated visits map of PPR sities. The data is from safegraph.
visitCount789 <-
st_join(visitCount %>% st_transform(crs=4326),pprServiceArea%>% st_transform(crs=4326),left=TRUE) %>%
filter(PPR_DIST %in% c(7,8,9))
visitCount789 <- visitCount789 %>%
dplyr::select(placekey,visits) %>%
st_drop_geometry() %>%
group_by(placekey) %>%
mutate(totalVisits = sum(visits)) %>%
dplyr::select(-visits) %>%
distinct()From above, we can know Christy Recreation Center(zzz-222@63s-dvq-5fz) has the most frequent visits among district 7,8,9. The total visits is 420776
Figure Matthias Baldwin Park
Figure Matthias Baldwin Park
sumVisit <- dwellTime %>%
filter(placekey=='zzz-222@63s-dvq-5fz') %>%
dplyr::select(-month) %>%
group_by(dwellTimes) %>%
summarise(visitors=sum(visitors)) %>%
st_drop_geometry()
sumVisit$dwellTimes <- factor(sumVisit$dwellTimes, levels= c("<5","5-10","11-20","21-60","61-120","121-240",">240" ))
sumVisit%>%
ggplot(aes(dwellTimes,visitors)) +
geom_bar(position ="dodge",fill = palette1_main,stat='identity') +
labs(x="Dwell Time", y="Aggregated Visitors",
title ='Christy Recreation Center (zzz-222@63s-dvq-5fz)') +
plotTheme(10,20)
Figure. Map of dwell time
visitCount %>%
filter(placekey=='zzz-222@63s-dvq-5fz') %>%
st_drop_geometry()%>%
na.omit()%>%
ggplot(aes(visitDay,visits)) +
geom_line(color=palette1_main,size=1)+
labs(title = 'Christy Recreation Center (zzz-222@63s-dvq-5fz)',x="Visit Date",y="Safegraph Visit")+
plotTheme(10,20)+
theme(panel.border = element_rect(colour = "black", fill=NA, size=1))
Figure. Map of dwell time
sumVisit <- visitHour %>%
filter(placekey=='zzz-222@63s-dvq-5fz') %>%
dplyr::select(-month) %>%
group_by(hour) %>%
summarise(visits=sum(visit)) %>%
st_drop_geometry()
sumVisit%>%
ggplot(aes(hour,visits)) +
geom_bar(position ="dodge",fill = palette1_main,stat='identity') +
labs(x="hour", y="Aggregated Visits",
title ='Christy Recreation Center (zzz-222@63s-dvq-5fz)') +
plotTheme(10,20)
Figure. Map of visit time
ggplot(data = orgCountPlot2) +
geom_sf(data = pprServiceArea %>% st_transform(crs=4326),fill ="transparent", color="black",size=0.5)+
geom_sf(data=pprDistrict %>% st_transform(crs=4326),fill ="transparent", color="black",size=1)+
geom_curve(aes(x = origin.x,
y = origin.y,
xend = park.x,
yend = park.y,
color = q5(visitors)),
size = 0.5,
curvature = -0.2,
alpha = 0.4,
arrow = arrow(length = unit(0.01, "npc")))+
scale_color_manual(values = palette5,
labels = qBr(orgCountPlot2,"visitors"),
name = "Visitors (Quintile Breaks)") +
labs(x="",y="")+
mapTheme()+
theme(legend.position = "bottom",panel.spacing = unit(6, 'lines'),
legend.key.width = unit(0.5, 'cm'),
legend.key.height = unit(0.2, 'cm'))
Figure. Flow map of parks and origins
ggplot(data = orgCountPlotHF) +
geom_sf(data = pprServiceArea %>% st_transform(crs=4326),fill ="transparent", color="black",size=1)+
geom_sf(data=pprDistrict %>% st_transform(crs=4326),fill ="transparent", color="black",size=2)+
geom_curve(aes(x = origin.x,
y = origin.y,
xend = park.x,
yend = park.y),
size = 2.5,
color = palette1_main,
curvature = -0.2,
alpha = 0.4,
arrow = arrow(length = unit(0.01, "npc")))+
labs(x="",y="")+
mapTheme()+
theme(legend.position = "bottom",panel.spacing = unit(6, 'lines'),
legend.key.width = unit(1.5, 'cm'),
legend.key.height = unit(1.2, 'cm'))
Figure. Flow map of parks and origins - High Frequency
ggplot(data = depaCountPlot2) +
geom_sf(data = pprServiceArea %>% st_transform(crs=4326),fill ="transparent", color="black",size=0.5)+
geom_sf(data=pprDistrict %>% st_transform(crs=4326),fill ="transparent", color="black",size=1)+
geom_curve(aes(x = departure.x,
y = departure.y,
xend = park.x,
yend = park.y,
color = q5(visitors)),
size = 0.5,
curvature = -0.2,
alpha = 0.4,
arrow = arrow(length = unit(0.01, "npc")))+
scale_color_manual(values = palette5,
labels = qBr(depaCountPlot2,"visitors"),
name = "Visitors (Quintile Breaks)") +
labs(x="",y="")+
mapTheme()+
theme(legend.position = "bottom",panel.spacing = unit(6, 'lines'),
legend.key.width = unit(0.5, 'cm'),
legend.key.height = unit(0.2, 'cm'))
Figure. Flow map of parks and departure points
ggplot(data = depaCountPlotHF) +
geom_sf(data = pprServiceArea %>% st_transform(crs=4326),fill ="transparent", color="black",size=0.5)+
geom_sf(data=pprDistrict %>% st_transform(crs=4326),fill ="transparent", color="black",size=1)+
geom_curve(aes(x = departure.x,
y = departure.y,
xend = park.x,
yend = park.y),
size = 0.5,
color = palette1_main,
curvature = -0.2,
alpha = 0.4,
arrow = arrow(length = unit(0.01, "npc")))+
labs(x="",y="")+
mapTheme()+
theme(legend.position = "bottom",panel.spacing = unit(6, 'lines'),
legend.key.width = unit(0.5, 'cm'),
legend.key.height = unit(0.2, 'cm'))
Figure. Flow map of parks and departure - High Frequency
dwellTimeForPlot <- dwellTime %>%
mutate(dwellTimes = recode(dwellTimes,
"<5" = 2.5,
"5-10" = 7.5,
"11-20" = 15,
"21-60" = 40,
"61-120" = 90,
"121-240" = 180,
">240" = 0)) %>%
mutate(sepTotalDwellTime = (visitors*dwellTimes)) %>%
group_by(placekey) %>%
mutate(totalVisitors=sum(visitors) )%>%
filter(totalVisitors>50) %>%
mutate(avgDwellTime=sum(sepTotalDwellTime)/totalVisitors) %>%
dplyr::select(placekey,avgDwellTime) %>%
distinct()
ggplot(dwellTimeForPlot)+
geom_sf(data=pprServiceArea,
color='black',
size=0.25,
fill= "transparent")+
geom_sf(data=pprDistrict,
color='black',
size=0.75,
fill='transparent')+
geom_sf(aes(size = avgDwellTime,
color = avgDwellTime),
alpha = 0.5) +
scale_size_continuous(range = c(1, 3),
name = "avgDwellTime")+
scale_color_continuous(low = '#FFDEDB',high ='#FF2903',
name = "avgDwellTime") +
mapTheme()+
theme(legend.position = "bottom",
legend.key.width = unit(0.5, 'cm'),
legend.key.height = unit(0.2, 'cm'))
Figure. Map of dwell time
From the above plot we can see the largest dwelling time is at Girard Park (zzz-222@628-pgb-k75) with avgerage dwelling time is 94.9. Interestingly, there is not program by PPR in this park in 2021. There is a activity organized by citizens themselves. The activity is yoga, from April to September, every 1pm to 2pm on Sunday.
Longest Dwell Time
Figure Matthias Baldwin Park
sumVisit <- dwellTime %>%
filter(placekey=='zzz-222@628-pgb-k75') %>%
dplyr::select(-month) %>%
group_by(dwellTimes) %>%
summarise(visitors=sum(visitors)) %>%
st_drop_geometry()
sumVisit$dwellTimes <- factor(sumVisit$dwellTimes, levels= c("<5","5-10","11-20","21-60","61-120","121-240",">240" ))
sumVisit%>%
ggplot(aes(dwellTimes,visitors)) +
geom_bar(position ="dodge",fill = palette1_main,stat='identity') +
labs(x="Dwell Time", y="Aggregated Visitors",
title ='Girard Park (zzz-222@628-pgb-k75)') +
plotTheme(10,20)
Figure. Map of dwell time
visitCount %>%
filter(placekey=='zzz-222@628-pgb-k75') %>%
st_drop_geometry()%>%
na.omit()%>%
ggplot(aes(visitDay,visits)) +
geom_line(color=palette1_main,size=1)+
labs(title = 'Girard Park',x="Visit Date",y="Safegraph Visit")+
plotTheme(10,20)+
theme(panel.border = element_rect(colour = "black", fill=NA, size=1))
Figure. Map of dwell time
sumVisit <- visitHour %>%
filter(placekey=='zzz-222@628-pgb-k75') %>%
dplyr::select(-month) %>%
group_by(hour) %>%
summarise(visits=sum(visit)) %>%
st_drop_geometry()
sumVisit%>%
ggplot(aes(hour,visits)) +
geom_bar(position ="dodge",fill = palette1_main,stat='identity') +
labs(x="hour", y="Aggregated Visits",
title ='Girard Park (zzz-222@628-pgb-k75)') +
plotTheme(10,20)
Figure. Map of visit time